home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / TritonGadgets.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  5.5 KB  |  168 lines
  1. PROGRAM GadgetDemo;
  2.  
  3. uses triton, tritonmacros, vartags, utility;
  4.  
  5. {
  6.     If you have seen gadtoolsgadgets.c in the RKRM's then you
  7.     have seen this program. One diffs is that this example
  8.     is made in Triton. Much better.:)
  9.     Jun 06 1998
  10.     nils.sjoholm@mailbox.swipnet.se
  11. }
  12.  
  13.  
  14.  
  15.  
  16. CONST
  17.     MYGAD_SLIDER     = 1;
  18.     MYGAD_SLIDERTEXT = 10;
  19.     MYGAD_STRING1    = 2;
  20.     MYGAD_STRING2    = 3;
  21.     MYGAD_STRING3    = 4;
  22.     MYGAD_BUTTON     = 5;
  23.  
  24. (* Range for the slider: *)
  25.     SLIDER_MIN  = 1;
  26.     SLIDER_MAX  = 20;
  27.     SLIDER_DEF  = 10;
  28. VAR
  29.     Project     : pTR_Project;
  30.     trmsg       : pTR_Message;
  31.     quit        : Boolean;
  32.     dummy       : longint;
  33.     Triton_App  : pTR_App;
  34.  
  35. Function longToStr (I : Longint) : String;
  36.  
  37.      Var S : String;
  38.  
  39.      begin
  40.       Str (I,S);
  41.       longToStr:=S;
  42.      end;
  43.  
  44.  
  45. PROCEDURE CleanExit(errstring : STRING; rc : Integer);
  46. BEGIN
  47.     IF Project <> NIL THEN TR_CloseProject(Project);
  48.     if Triton_App <> nil then TR_DeleteApp(Triton_App);
  49.     IF errstring <> '' THEN WriteLn(errstring);
  50.     Halt(rc)
  51. END;
  52.  
  53.  
  54.  
  55. begin
  56.  
  57.     Triton_App := TR_CreateApp(TAGS(
  58.                      TRCA_Name,longstr('TritonGadtools'),
  59.                      TRCA_LongName,longstr('GadToolsDemo in Triton'),
  60.                      TRCA_Version,longstr('0.01'),
  61.                      TRCA_Info,longstr('Just a test of Triton'),
  62.                      TRCA_Release,longstr('1'),
  63.                      TRCA_Date,longstr('26-05-1998'),
  64.                      TAG_DONE));
  65.  
  66.      if Triton_App = nil then CleanExit('Can''t create Application',20);
  67.      
  68.      ProjectStart;
  69.      WindowID(1);
  70.      WindowTitle('Instead of GadTools :)');
  71.      WindowPosition(TRWP_CENTERTOP);
  72.          HorizGroupA;
  73.              Space;
  74.              VertGroupA;
  75.                  Space;
  76.                 LineArray;
  77.                     BeginLine;
  78.                         Space;
  79.                         TextID('_Volume:',MYGAD_SLIDER); SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
  80.                         Space;
  81.                         SliderGadget(SLIDER_MIN,SLIDER_MAX,5,MYGAD_SLIDER);
  82.                         Space;
  83.                         TextID(pchar('5'#0),MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
  84.                         Space;
  85.                     EndLine;
  86.                     SpaceS;
  87.                     BeginLine;
  88.                         Space;
  89.                         TextID('_First:',MYGAD_STRING1); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
  90.                         Space;
  91.                         StringGadget('Try pressing',MYGAD_STRING1); SetTRTag(TRAT_Value,50);
  92.                         Space;
  93.                     EndLine;
  94.                     SpaceS;
  95.                     BeginLine;
  96.                         Space;
  97.                         TextID('_Second:',MYGAD_STRING2); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
  98.                         Space;
  99.                         StringGadget('TAB or Shift-TAB',MYGAD_STRING2); SetTRTag(TRAT_Value,50);
  100.                         Space;
  101.                     EndLine;
  102.                     SpaceS;
  103.                     BeginLine;
  104.                         Space;
  105.                         TextID('_Third:',MYGAD_STRING3); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
  106.                         Space;
  107.                         StringGadget('To see what happens!',MYGAD_STRING3); SetTRTag(TRAT_Value,50);
  108.                         Space;
  109.                     EndLine;
  110.                 EndArray;
  111.                 Space;
  112.                         CenteredButton('_Click Here',MYGAD_BUTTON);
  113.                 Space;
  114.             EndGroup;
  115.             Space;
  116.         EndGroup;
  117.      EndProject;
  118.  
  119.  
  120.  
  121.     Project := TR_OpenProject(Triton_App,@tritontags);
  122.     IF Project = NIL THEN CleanExit('No project',20);
  123.  
  124.     quit := False;
  125.     WHILE NOT quit DO BEGIN
  126.       dummy := TR_Wait(Triton_App,0);
  127.       REPEAT
  128.         trmsg := TR_GetMsg(Triton_App);
  129.         IF trmsg <> NIL THEN BEGIN
  130.           IF (trmsg^.trm_Project = Project) THEN BEGIN
  131.              CASE trmsg^.trm_Class OF
  132.  
  133.                TRMS_CLOSEWINDOW : quit := True;
  134.  
  135.                TRMS_NEWVALUE    :
  136.                        BEGIN
  137.                        case trmsg^.trm_ID of
  138.                          MYGAD_SLIDER  : begin
  139.                                          TR_SetText(Project,MYGAD_SLIDERTEXT,LongToStr(trmsg^.trm_Data));
  140.                                          writeln('Slider at level ',trmsg^.trm_Data);
  141.                                          end;
  142.                          MYGAD_STRING1 : writeln('String Gadget 1: "',TR_GetString(Project,MYGAD_STRING1),'".');
  143.                          MYGAD_STRING2 : writeln('String Gadget 2: "',TR_GetString(Project,MYGAD_STRING2),'".');
  144.                          MYGAD_STRING3 : writeln('String Gadget 3: "',TR_GetString(Project,MYGAD_STRING3),'".');
  145.                        END;
  146.                        END;
  147.                TRMS_ACTION :
  148.                       BEGIN
  149.                       if trmsg^.trm_ID = MYGAD_BUTTON then begin
  150.                                            TR_SetValue(Project,MYGAD_SLIDER,SLIDER_DEF);
  151.                                            TR_SetText(Project,MYGAD_SLIDERTEXT,LongToStr(SLIDER_DEF));
  152.                                            writeln('Button was pressed, slider reset to 10.');
  153.                                          end;
  154.                       END;
  155.                TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  156.              END;
  157.            END;
  158.            TR_ReplyMsg(trmsg);
  159.          END;
  160.        UNTIL quit OR (trmsg = NIL);
  161.     END;
  162.     CleanExit('',0);
  163. END.
  164.  
  165.  
  166.  
  167.  
  168.